COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "ANIMED"
C00006 00003	SUBR LOOK
C00011 00004	SUBR MOVB
C00014 00005	MKUNIVGEODPYWO←DAD(UNIVERSE)N←FNUM←1
C00017 00006	   IF CI="I" THEN BEGIN "INANI"
C00022 ENDMK
C⊗;
BEGIN "ANIMED"
	REQUIRE "GEOMES.HDR[TMP,LCS]" SOURCE_FILE;
	DEFINE α="COMMENT";
	DEFINE SUBR="SIMPLE INTEGER PROCEDURE";

	STRING STR;REAL FO;
	INTEGER TF,NFR,NT,TMP,CAM;
	INTEGER CI,WO,CB,FNUM,CHR,N,I,NOF;
	INTEGER CFR,CT,PFR,NAM1,NAM2;
	SAFE INTEGER ARRAY BLIST[1:200];

	SUBR NINK(INTEGER Q);START_CODE HLRZ 1,Q;END;
	SUBR PINK(INTEGER Q);START_CODE HRRZ 1,Q;END;

SUBR COPTRM;
START_CODE
	HRRZ 1,NFR; MOVE 2,FNUM; CAME 2,(1); HRRZ 1,PFR;
	HRRZM 1,CFR; HRRZ 1,6(1); HRLZI 1,-3(1); 
	HRRZ 2,CB; HRRZ 2,6(2); HRRI 1,-3(2); BLT 1,8(2);
END;

SUBR MOVED(INTEGER Q);
START_CODE 
	LABEL L1;
	HRRZ 1,CB; HRRZ 1,6(1);
	HRRZ 2,Q; HRRZ 2,6(2);
	MOVE 3,-3(1); CAME 3,-3(2); JRST L1;
	MOVE 3,-2(1); CAME 3,-2(2); JRST L1;
	MOVE 3,-1(1); CAME 3,-1(2); JRST L1;
	MOVE 3,(1); CAME 3,(2); JRST L1;
	MOVE 3,1(1); CAME 3,1(2); JRST L1;
	MOVE 3,2(1); CAME 3,2(2); JRST L1;
	MOVE 3,3(1); CAME 3,3(2); JRST L1;
	MOVE 3,4(1); CAME 3,4(2); JRST L1;
	MOVE 3,5(1); CAME 3,5(2); JRST L1;
	MOVE 3,6(1); CAME 3,6(2); JRST L1;
	MOVE 3,7(1); CAME 3,7(2); JRST L1;
	MOVE 3,8(1); CAME 3,8(2); JRST L1;
	HRRZ 2,Q; SKIPE 3,5(2); CAMN 3,3(1); CAIA;
    L1:	SKIPA 1,L1; SETZ 1,;
END;

SUBR NAMEQ;
START_CODE
	SETZ 1,;
	HRRZ 3,I; ADD 3,BLIST;
	MOVE 2,(3); MOVE 3,1(3);
	CAMN 2,NAM1; CAME 3,NAM2;
	CAIA; SETO 1,;
END;

SUBR ADNODE;
BEGIN "ADNODE"
	  CFR←MKNODE(FNUM);MVNUM(CFR)←FNUM;
	  CT←MKCOPY(TRAM(CB));TRAM$(CT,CFR);
	  CW$(NFR,CFR);CCW$(PFR,CFR);
	  CW$(CFR,PFR);CCW$(CFR,NFR);
END "ADNODE";

SUBR LOOK;
BEGIN
	I←-2;
	DO I←I+3 UNTIL I=N∨NAMEQ;
	IF I≠N THEN BEGIN "SEEN"
	  PFR←PINK(BLIST[I]);NFR←NINK(BLIST[I]);
	  IF MVNUM(PFR)≤FNUM THEN BEGIN "ATEND"
	    IF MVNUM(PFR)≠FNUM THEN
	      IF MOVED(PFR) THEN BEGIN
		ADNODE;
		BLIST[I]←XWD(NINK(BLIST[I]),CFR);END
	      ELSE MVNUM(PFR)←FNUM
	    ELSE IF SNUM(PFR)=FNUM THEN COPTRM
	    ELSE IF MOVED(PFR) THEN BEGIN
	      ADNODE;
	      BLIST[I]←XWD(NINK(BLIST[I]),CFR);
	      MVNUM(PFR)←SNUM(PFR);END;
	  END "ATEND"
	  ELSE IF SNUM(NFR)≥FNUM THEN BEGIN "ATBEG"
	    IF SNUM(NFR)≠FNUM THEN
	      IF MOVED(NFR) THEN BEGIN
		ADNODE;
		BLIST[I]←XWD(CFR,BLIST[I]);END
	      ELSE SNUM(NFR)←FNUM
	    ELSE IF MVNUM(NFR)=FNUM THEN COPTRM
	    ELSE IF MOVED(NFR) THEN BEGIN
		ADNODE;
		BLIST[I]←XWD(CFR,BLIST[I]);
		SNUM(NFR)←MVNUM(NFR);END;
	  END "ATBEG"
	  ELSE BEGIN "FDFRM"
	    WHILE SNUM(PFR)≥FNUM DO PFR←CCW(PFR);
	    NFR←CW(PFR);
	    IF SNUM(NFR)=FNUM THEN
	      IF MVNUM(NFR)=FNUM THEN COPTRM
	      ELSE IF MOVED(PFR) THEN BEGIN
		  ADNODE;SNUM(NFR)←MVNUM(NFR);END
	      ELSE BEGIN
		  MVNUM(PFR)←FNUM;SNUM(NFR)←MVNUM(NFR);END
	    ELSE IF MVNUM(PFR)≤FNUM THEN
	      IF MOVED(PFR) THEN
		IF MOVED(NFR) THEN BEGIN
		  ADNODE;
		  IF MVNUM(PFR)=FNUM THEN MVNUM(PFR)←SNUM(PFR);END
		ELSE SNUM(NFR)←FNUM
	      ELSE MVNUM(PFR)←FNUM
	    ELSE IF MOVED(PFR) THEN BEGIN
	      NT←NFR;NFR←MKNODE(MVNUM(PFR));
	      CT←MKCOPY(TRAM(PFR));TRAM$(CT,NFR);
	      CW$(NT,NFR);CCW$(NFR,NT);
	      MVNUM(NFR)←SNUM(NFR);ADNODE;END;
	  END "FDFRM";
	END "SEEN" ELSE BEGIN "NOTSEEN"
	    CFR←MKNODE(FNUM);
	    CT←MKCOPY(TRAM(CB));
	    START_CODE
		HRRZ 1,CFR; HRRZ 2,CT; HRRZM 2,6(1);
		MOVE 2,FNUM; MOVEM 2,4(1);
		HRLI 1,(1); MOVEM 2,7(1); HRRZ 3,BLIST;
		ADD 3,N; MOVEM 1,-1(3);
		MOVE 1,NAM1; MOVE 2,NAM2; MOVEM 1,(3);
		MOVEM 2,1(3); HRRZI 1,3; ADDM 1,N;
	    END;
	END "NOTSEEN";
END;
SUBR MOVB;
BEGIN
	  TRANSL(CB,XWC(CFR),YWC(CFR),ZWC(CFR));
	  ROTATE(XWD(-2,CB),IY(CFR),IZ(CFR),JX(CFR));
	  TMP←CW(CFR);
	  IF SNUM(TMP)=FNUM+1 THEN NLINK$(TMP,CB);
END;

SUBR MOVEIT;
BEGIN
	    IF (CFR←NLINK(CB))≠CB THEN BEGIN
	      IF CFR=0 THEN BEGIN "SETUP"
		IF CAM THEN BEGIN
		  NAM1←"α";NAM2←0;END
		ELSE BEGIN
		  NAM1←MEMORY[CB-2];NAM2←MEMORY[CB-1];END;
		I←-2;
		DO I←I+3 UNTIL I=N∨NAMEQ;
		IF I≠N THEN BEGIN
		  PFR←CFR←NINK(BLIST[I]);
		  IF FNUM<SNUM(CFR) THEN DO CFR←CW(CFR)
		    UNTIL FNUM≥SNUM(CFR)∨CFR=PFR;
		  IF SNUM(CFR)<FNUM THEN BEGIN 
		    NLINK$(CB,CB);CFR←0;END
	          ELSE NLINK$(CFR,CB);END 
		ELSE NLINK$(CB,CB);
	      END "SETUP";
	      IF CFR THEN BEGIN "MOVIT"
		IF MVNUM(CFR)=FNUM THEN BEGIN
		  NFR←CW(CFR);
		  IF SNUM(NFR)>FNUM THEN BEGIN
		    CT←TRAM(CFR);NT←TRAM(NFR);
		    NOF←SNUM(NFR)-FNUM;TMP←MKCOPY(CT);
		    APTRAM(INTRAM(TMP),NT);CVTRMV(TMP);
		    IY(CFR)←XWC(TMP)/NOF;
		    IZ(CFR)←YWC(TMP)/NOF;
		    JX(CFR)←ZWC(TMP)/NOF;
		    KLNODE(TMP);
		    XWC(CFR)←(XWC(NT)-XWC(CT))/NOF;
		    YWC(CFR)←(YWC(NT)-YWC(CT))/NOF;
		    ZWC(CFR)←(ZWC(NT)-ZWC(CT))/NOF;
		    MOVB;
		  END ELSE NLINK$(CB,CB);
		END ELSE IF MVNUM(CFR)<FNUM THEN MOVB;
	      END "MOVIT";
	    END;
END;

MKUNIV;GEODPY;WO←DAD(UNIVERSE);N←FNUM←1;
WHILE TRUE DO BEGIN "COMS"

   GEOMED;
   CI←INCHRW;

   IF CI="A" THEN BEGIN "ADFRM"
	OUTSTR("
	FRM # "&CVS(FNUM)&"	FRM # = ");STR←INCHWL;
	IF LENGTH(STR)≠0 THEN FNUM←INTSCAN(STR,CHR);
	CB←NCCW(WO);CFR←NAM2←0;NAM1←"α";LOOK;
	IF CFR THEN FOCAL(CFR)←JX(CB);
	CB←WO;
	WHILE (CB←CW(CB))≠WO DO BEGIN
	  NAM1←MEMORY[CB-2];NAM2←MEMORY[CB-1];
	  LOOK;END;
   END "ADFRM";

   IF CI="R"∨CI="M" THEN BEGIN "MKMOVI"
	OUTSTR("
	FRM # "&CVS(FNUM)&"	START # = ");STR←INCHWL;
	IF LENGTH(STR)≠0 THEN FNUM←INTSCAN(STR,CHR);
	OUTSTR("	TOTAL FRAMES = ");STR←INCHWL;
	IF LENGTH(STR)≠0 THEN BEGIN
	TF←INTSCAN(STR,CHR);
	TF←TF+FNUM;CB←WO;NLINK$(0,NCCW(WO));
	WHILE WO≠(CB←CW(CB)) DO BEGIN
	  NLINK$(0,CB);BDET(CB);END;
	WHILE FNUM<TF DO BEGIN "FRAMES"
	  IF CI="R" THEN GEODPY;
	  CAM←CB←NCCW(WO);TMP←0;MOVEIT;
	  IF TMP THEN BEGIN
	    FO←JX(CB);
	    JX(CB)←FO+(FOCAL(TMP)-FO)/(SNUM(TMP)-FNUM);
	    IF JX(CB)>0 THEN BEGIN
	      FO←JX(CB)/FO;XWC(CB)←XWC(CB)*FO;
	      YWC(CB)←YWC(CB)*FO;ZWC(CB)←ZWC(CB)*FO;END
	    ELSE JX(CB)←FO;END;
	  CB←WO;CAM←0;
	  WHILE WO≠(CB←CW(CB)) DO MOVEIT;
	  FNUM←FNUM+1;
	END "FRAMES";
	END;
   END "MKMOVI";

   IF CI="I" THEN BEGIN "INANI"
   END "INANI";

   IF CI="O" THEN BEGIN "OUTANI"
	I←-2;
	WHILE (I←I+3)≠N DO BEGIN
	  NFR←NINK(BLIST[I]);
	END;
   END "OUTANI";

END "COMS";

END "ANIMED";